Homework IV

Zadanie 1.1

Wybrane zmienne:

Zadanie 1.2 - random forest

Zadanie 2 - wyznaczenie reszt

predictions <- predictLearner(lrn,model,data)[,2] 
residuals <- predictions - (as.numeric(data$S1)-1) 
hist(residuals)

Zadanie 3 - predictions:residuals plot

plot_data_dfr <- data.frame(res = residuals, pred = predictions)
ggplot(data = plot_data_dfr,aes(x = pred, y = res)) + 
  geom_point() + geom_smooth(method = "loess") + geom_hline(yintercept = 0, colour = "red")

Lokalny trend reszt w funkcji odpowiedzi modelu jest daleki od stałej równej zero. Widać że model nie zwraca wartości większych niż 0.8, dlatego loess nie miał szans wrócić w okolice zera przy wysokich predykcjach. Ponieważ maksymalna wartość random forest na zbiorze treningowym jest maksymalna wartością zwracaną z modelu można przeskalować trepdykcje. Niestety tym rozwiązaniem spowodujemy, że podawane przez model wartości nie będą już estymatorami prawdopodobieństw wystąpnienia danej klasy. Na obronę tego pomysły można zauważyć że już teraz estymacje prawdopodobieństw są błędne. Loess w punkcie 0.5 jest silnie poniżej 0 co wskazuje na większe występowanie klasy ‘1’ niż ‘0’ wśród obserwacji dla których przewidzana została wartość w okolicy 50%.

Zadanie 4 - partner_yrsed:residuals plot

plot_data_dfr <- data.frame(res = residuals, yrsed = data$partner_yrsed)

ggplot(data = plot_data_dfr,aes(x = yrsed, y = res)) +
  geom_point() + geom_smooth() + geom_hline(yintercept = 0, colour = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Błędy w funkcji zmiennej ‘yrsed’ rozkładają się równo wokół prostej równiej 0. Widzimy zatem, że model dobrze przewiduje prawdopodobieństwa przynależności do klasy w dla wszystkich wartości ‘yrsed’.

cook_dist <- numeric(nrow(data))
for(i in 1:nrow(data)){
  data_i <- data[-i,]
  task <- makeClassifTask(data = data_i, target = "S1")
  model <- train(lrn,task)
  predictions_i <- predictLearner(lrn,model,data)[,2] 
  cook_dist[i] <- ((predictions_i - predictions)^2) %>% sum
}

data_plot_dfr <- data.frame(cook= cook_dist, obs = as.factor(1:nrow(data)))
p <- ggplot(data = data_plot_dfr) + geom_point(aes(x = obs, y = cook))
ggplotly(p)

Random forest buduje głębokie drzewa, dlatego może się zadarzyć że kilka obserawcji będące szumem, przy korzystnym wylosowaniu bootstrapowym, mogą stworzyć własny liść. Taki liść uczestniczy potem w uśrednianiu po drzewach i może znacząco zaburzać predykcję innych obserwacji w tym obszarze. Najwyższą wartość Cook’a osiągnęła obserwacja 615. Poniżej zamieszczam próbę wyjaśnienia jej isotności.

data[615,]
##     time_from_rel_to_cohab hcm2017q24_college hcm2017q24_bar_restaurant
## 866                  11.25                  1                         1
##     partner_yrsed S1
## 866            16  2
predictions[615]
## [1] 0.4789045
dist_mat <- dist(data[,-5]) %>% as.matrix
closest <- data.frame(dist = dist_mat[615,], n = 1:nrow(data)) %>% arrange(dist) %>% head(10)
cbind(data,predictions)[closest$n,]
##      time_from_rel_to_cohab hcm2017q24_college hcm2017q24_bar_restaurant
## 866               11.250000                  1                         1
## 3135              10.500000                  0                         1
## 458               11.333252                  0                         0
## 946               11.166748                  0                         0
## 3255              11.833374                  0                         0
## 2034              11.916748                  0                         0
## 1740              10.416626                  0                         0
## 2446              10.416626                  0                         0
## 1403              10.333252                  1                         0
## 2563               9.666748                  1                         0
##      partner_yrsed S1 predictions
## 866             16  2  0.47890446
## 3135            16  2  0.47011987
## 458             16  1  0.09362823
## 946             16  1  0.10628830
## 3255            16  1  0.08939878
## 2034            16  1  0.08794712
## 1740            16  1  0.12230644
## 2446            16  1  0.12230644
## 1403            17  1  0.15366446
## 2563            16  1  0.16497022
cook_dist[2259]
## [1] 0.3270322
cook_dist[615]
## [1] 0.3433722

Prawdopodobieństwo przynależności obserwacji ‘615’ do klasy ‘2’ wynosi ‘0.5’, widzimy że istnieje jeszcze jedna obserwacja bardzo blisko polożona(w przestrzeni euklidesowej), która również pochodzi z klasy ‘2’. Kolejne kilkanaście obserwacji (obserwacje posortowane wg odlełości od ‘615’) należą już do klasy ‘1’. Odpowiedzi modelu dla nich są dość niskie. Takie zachowanie może świadczyć o overfitingu (dopasowanie modelu do dwóch obserwacji, mimo że w otoczeniu przeważa klasa ‘1’). Co ważne, próba dopasowania się modelu do tych obserwacji powoduje zwiększenie wartośći również obserwacją w ich otoczeniu. Zapewne dlatego usunięcie tej obserwacji (uniemożliwienie budowania liścia dla klasy ‘2’ w tym miejscu przestrzeni atrybutów) powoduje dużą predykcji modelu. Za tą hipotezą przemawia również wysoka wartość drugiej obserwacji z klasy ‘2’ położonej blisko ‘615’ tj. ‘2259’ (Cook = 0.33).